home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0018_Screen Fades.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  2.2 KB  |  82 lines
  1. {
  2. CHRIS BEISEL
  3.  
  4. I've gotten many compliments on these two fade routines (a few good
  5. programmers thought they were asm!)... plus, I made them so you can fade
  6. part on the palette also... It's very smooth on my 486, as well as 386's
  7. and 286's at friends houses...
  8.  
  9.         set up in your type declarations
  10.                 rgbtype=record
  11.                     red,green,blue:byte;
  12.                 end;
  13.                 rgbarray[0..255] of rgbtype;
  14.  
  15.         and in your var declarations have something like
  16.                 rgbpal:rgbarray;
  17.  
  18.         and set your colors in that...
  19. }
  20. procedure fadein(fadepal : rgbarray; col1, col2 : byte);
  21. var
  22.   lcv,
  23.   lcv2 : integer;
  24.   tpal : rgbarray;
  25. begin
  26.   for lcv := col1 to col2 do
  27.   begin
  28.     TPal[lcv].red   := 0;
  29.     TPal[lcv].green := 0;
  30.     TPal[lcv].blue  := 0;
  31.   end;
  32.   for lcv := 0 to 63 do
  33.   begin
  34.     for lcv2:=col1 to col2 do
  35.     begin
  36.       if fadepal[lcv2].red > TPal[lcv2].red then
  37.         TPal[lcv2].red := TPal[lcv2].red + 1;
  38.       if fadepal[lcv2].green > TPal[lcv2].green then
  39.         TPal[lcv2].green := TPal[lcv2].green + 1;
  40.       if fadepal[lcv2].blue > TPal[lcv2].blue then
  41.         TPal[lcv2].blue := TPal[lcv2].blue+1;
  42.  
  43.       setcolor(lcv2, TPal[lcv2].red, TPal[lcv2].green, TPal[lcv2].blue);
  44.     end;
  45.     refresh;
  46.   end;
  47. end;
  48.  
  49. {*******************************************************************}
  50.  
  51. procedure fadeout(fadepal : rgbarray; col1, col2 : byte);
  52. var
  53.   lcv,
  54.   lcv2 : integer;
  55.   TPal : rgbarray;
  56. begin
  57.   for lcv := col1 to col2 do
  58.   begin
  59.     TPal[lcv].red   := 0;
  60.     TPal[lcv].green := 0;
  61.     TPal[lcv].blue  := 0;
  62.   end;
  63.   for lcv := 0 to 63 do
  64.   begin
  65.     for lcv2 := col1 to col2 do
  66.     begin
  67.       if fadepal[lcv2].red > TPal[lcv2].red then
  68.         fadepal[lcv2].red := fadepal[lcv2].red - 1;
  69.       if fadepal[lcv2].green > TPal[lcv2].green then
  70.         fadepal[lcv2].green := fadepal[lcv2].green - 1;
  71.       if fadepal[lcv2].blue > TPal[lcv2].blue then
  72.         fadepal[lcv2].blue := fadepal[lcv2].blue - 1;
  73.  
  74.       setcolor(lcv2, fadepal[lcv2].red, fadepal[lcv2].green, fadepal[lcv2].blue);
  75.     end;
  76.     refresh;
  77.   end;
  78. end;
  79.  
  80. {*******************************************************************}
  81.  
  82.